home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / hypercar / xfcn / spttool.cpt / Support Tools eXternals 1.2.5 / card_33339.txt < prev    next >
Text File  |  1990-11-13  |  11KB  |  312 lines
  1. -- card: 33339 from stack: in.5
  2. -- bmap block id: 8933
  3. -- flags: 0000
  4. -- background id: 3858
  5. -- name: FileCreator
  6. ----- HyperTalk script -----
  7. on HideObjects
  8.   hide cd btn "Try It!"
  9. end HideObjects
  10.  
  11. on ShowObjects
  12.   show cd btn "Try It!"
  13. end ShowObjects
  14.  
  15.  
  16. -- part 1 (button)
  17. -- low flags: 00
  18. -- high flags: A002
  19. -- rect: left=82 top=185 right=219 bottom=175
  20. -- title width / last selected line: 0
  21. -- icon id / first selected line: 0 / 0
  22. -- text alignment: 1
  23. -- font id: 0
  24. -- text size: 12
  25. -- style flags: 8192
  26. -- line height: 16
  27. -- part name: Try it!
  28. ----- HyperTalk script -----
  29. on mouseUp
  30.   global errGlobal
  31.   put FilePath("", "Choose a file please.") into fileName
  32.   if fileName = empty then exit mouseUp
  33.   put FileCreator(fileName, "nodialog:errGlobal") into fCreator
  34.   if errGlobal Γëá empty then
  35.     answer "Error: ΓÇ£" & errGlobal & "ΓÇ¥"
  36.     put empty into errGlobal
  37.   else
  38.     answer "The creator string for ΓÇ£" & fileName & "ΓÇ¥ is ΓÇ£" & fCreator & "ΓÇ¥"
  39.   end if
  40. end mouseUp
  41.  
  42.  
  43.  
  44.  
  45. -- part contents for background part 38
  46. ----- text -----
  47. 15/50
  48.  
  49. -- part contents for background part 20
  50. ----- text -----
  51. FileCreator - An XFCN to return a file's creator
  52.  
  53. FileCreator(pathname, ┬½"noDialog:"errorGlobal┬╗)
  54.  
  55. This XFCN returns the four character creator for the file specified in pathname.  
  56.  
  57.  
  58. -- part contents for background part 42
  59. ----- text -----
  60. { FileCreator(pathname ┬½,"nodialog":errGlobal┬╗)                     }
  61. { XFCN to return the creator for the file specified by              }
  62. { the path given in the first parameter.                                    }
  63. {}
  64. {   Written by:      Anup Murarka         Eric Carlson             }
  65. {               ALINK:  SKEPTIC       ALINK:  cyNic       }
  66. {                                   CIS:  76004,3356}
  67. {}
  68. {               We are part of the Support Tools Development Group,     }
  69. {               Apple Computer, Inc.      }
  70. {}
  71. {               please DO NOT contack Mac DTS for support of this code!    }
  72. {}
  73. {               please DO contact the authors for support of this code!     }
  74. {}
  75. {               Send comments, bug reports, requests to any of the above   }
  76. {               E-mail addresses or to:}
  77. {}
  78. {                           (one of us)                  }
  79. {                           Apple Computer, Inc.          }
  80. {                           900 E. Hamilton, Ave.          }
  81. {                           Campbell, CA   95008      }
  82. {                           M/S 72-L                     }
  83. {}
  84. {   Copyright:   ┬⌐ 1989, 1990 by Apple Computer, Inc., all rights reserved.     }
  85. {}
  86. { written by    : Anup Murarka                                                                               }
  87. { AppleLink  : Skeptic                                                                                      }
  88. { modification history                                                                                        }
  89. {          Date              Initials                                    Comments                                           }
  90. {          ----          ------          ------------------------------------------------------      }
  91. {       8/16/89           akm         first written                                                                       }
  92. {       5/22/90           ec            removed upper case converion for A/UX compatibility.   }
  93. {                                           Changed version to 1.1                                                      }
  94. {}
  95. unit FileCreator;
  96.  
  97. interface
  98.  
  99.     uses
  100.         HyperXCmd;
  101.  
  102.     procedure MAIN (paramPtr: XCmdPtr);
  103.  
  104. implementation
  105.  
  106.     procedure FileCreator (paramPtr: XCmdPtr);
  107.     FORWARD;
  108.  
  109.     procedure MAIN (paramPtr: XCmdPtr);
  110.     begin
  111.         FileCreator(paramPtr);
  112.     end;
  113.  
  114.     procedure reportToUser (paramPtr: XCmdPtr; msgStr: str255);
  115. {}
  116. { report something back to the user.  }
  117. { the last parameter (optional) to an external may contain }
  118.  { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
  119.  { of a HyperTalk global variable into which error messages will be }
  120.  { placed.  we've decided to use this approach to avoid confusing }
  121. { an error message with a valid result being returned from an XFCN. }
  122. {}
  123.         var
  124.             tempStr: str255;
  125.     begin
  126. {check the last param to see if the user requested that}
  127. { we suppress the error dialog }
  128.         ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
  129.         UprString(tempStr, true);
  130.         if pos('NODIALOG', tempStr) = 0 then
  131.     { no special error handling specified, throw up a dialog and return the error message }
  132.             begin
  133.                 SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
  134.                 paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  135.             end
  136.         else if (pos(':', tempStr) > 0) then
  137.     { requested global AND noDialog so we fill in the global and return empty }
  138.             begin
  139.                 tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
  140.                                                         { get the name of the HC global  to fill }
  141.                 SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
  142.                                                         { and fill it }
  143.                 paramPtr^.returnValue := PasToZero(paramPtr, '');      { return empty }
  144.             end
  145.         else
  146.     { requested noDialog only so we return the error condition as the result }
  147.             paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  148.     end;     { procedure }
  149.  
  150.     function AskedForHelp (paramPtr: XCmdPtr; syntaxMsg: Str255; copyrightMsg: Str255): boolean;
  151. {   check to see if the user sent a '?' or a '!' as }
  152. { the only parameter. if so we will respond with }
  153. { the calling syntax or the copyright/version info }
  154. { for this external }
  155. {}
  156.         var
  157.             firstStr: str255;
  158.     begin
  159.         askedForHelp := false;
  160.         if paramPtr^.paramCount = 1 then
  161.             begin
  162.                 ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
  163.                     { what is the first param? }
  164.                 if firstStr = '?' then
  165.                     begin
  166.                         reportToUser(paramPtr, syntaxMsg);
  167.                         askedForHelp := true
  168.                     end  { asked for help }
  169.                 else if firstStr = '!' then
  170.                     begin
  171.                         reportToUser(paramPtr, copyRightMsg);
  172.                         askedForHelp := true
  173.                     end;     { asked for copyright info }
  174.             end;     { one parameter passed }
  175.     end;     { function }
  176.  
  177.     function BitTest (AddressToCheck: ptr; TotalBits: integer; BitToTest: longint): boolean;
  178.     { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
  179.     { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
  180.     begin
  181.         BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
  182.     end;
  183.  
  184.     function NumberToString (paramPtr: XCmdPtr; num: LONGINT): Str255;
  185. { use the toolbox call rather than HC's }
  186.         var
  187.             tempStr: str255;
  188.     begin
  189.         NumToString(num, tempStr);
  190.         NumberToString := tempStr;
  191.     end;
  192.  
  193.     procedure reportResError (paramPtr: XCmdPtr; errorNum: integer);
  194.         var
  195.             errMsg, tempName: str255;
  196.     begin
  197.         case errorNum of                   { what caused the problem? }
  198.             -0: 
  199.                 errMsg := 'no error.';
  200.             -36: 
  201.                 errMsg := 'I/O Error.';
  202.             -37: 
  203.                 errMsg := 'bad file name or volume name.';
  204.             -38: 
  205.                 errMsg := 'file not open.';
  206.             -39: 
  207.                 errMsg := 'that file has no resource fork.';
  208.             -42: 
  209.                 errMsg := 'too many files open.';
  210.             -43: 
  211.                 errMsg := 'file not found.';
  212.             -45, -54, -61: 
  213.                 errMsg := 'file locked.';
  214.             -47, -49: 
  215.                 errMsg := 'file is busy.';
  216.             -53: 
  217.                 errMsg := 'that volume is not on line.';
  218.             -108: 
  219.                 errMsg := 'not enough room in heap zone.';
  220.             -120: 
  221.                 errMsg := 'directory not found.';
  222.             -121: 
  223.                 errMsg := 'too many working directories open.';
  224.             -127: 
  225.                 errMsg := 'internal file system error.';
  226.             -192: 
  227.                 errMsg := 'resource not found.';
  228.             -193: 
  229.                 errMsg := 'file not found.';
  230.             otherwise
  231.                 errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
  232.         end;         { case }
  233.  
  234.         errMsg := concat('Sorry, ', errMsg);
  235.         reportToUser(paramPtr, errMsg);
  236.         { return the error message }
  237.     end;         { function }
  238.  
  239.     function getParams (paramPtr: XCmdPtr; var PathToFile: str255): boolean;
  240.     { function to get the parameters and validate them.  Returns boolean}
  241.     { instructing the main procedure to continue if the parameters passed}
  242.     { are valid.  Also returns syntax messages if requested by the user.}
  243.         var
  244.             numParams: integer;
  245.             syntaxStr, copyrightStr: str255;
  246.  
  247.     begin
  248.         getParams := true;     {Initially, assume the parameters are valid.}
  249.         syntaxStr := 'FileCreator(pathname ┬½,"nodialog":errGlobal┬╗)';
  250.         copyrightStr := '┬⌐ 1989,1990 Apple Computer, Inc., v.1.1, by Anup Murarka';
  251.  
  252.         {check that we have the proper number of parameters}
  253.         numParams := paramPtr^.paramCount;
  254.         if (numParams < 1) or (numParams > 2) then
  255.             begin
  256.                 getParams := false;
  257.                 reportToUser(paramPtr, syntaxStr);
  258.                 exit(getParams);
  259.             end;
  260.  
  261.         if AskedForHelp(paramPtr, syntaxStr, copyrightStr) then
  262.             begin
  263.                 getParams := false;
  264.                 exit(getParams);
  265.             end;
  266.  
  267.         { convert HyperCard's zero terminated string to a Pascal string}
  268.         ZeroToPas(paramPtr, paramPtr^.Params[1]^, PathToFile);
  269.     end;         {GetParams}
  270.  
  271.     procedure FileCreator (paramPtr: XCmdPtr);
  272.         var
  273.             getParamsOK: boolean;
  274.             FileName: str255;
  275.             paramBlock: CInfoPBRec;
  276.             errorCode: OSerr;
  277.             charIndex: integer;
  278.  
  279.     begin   { FileCreator}
  280.     { fetch and validate the passed parameters}
  281.         getParamsOK := getParams(paramPtr, FileName);
  282.         if not (getParamsOK) then
  283.             exit(FileCreator);
  284.  
  285.     { Initialize the parameter block.  Since we have the full pathname,}
  286.     { no other field is really needed.}
  287.         zeroBytes(paramPtr, @paramBlock, sizeOf(paramBlock));
  288.         paramBlock.ioNamePtr := @FileName;
  289.  
  290.         errorCode := PBGetCatInfo(@paramBlock, FALSE);
  291.         if errorCode <> noErr then
  292.             begin
  293.                 reportResError(paramPtr, errorCode);
  294.                 exit(FileCreator)
  295.             end;
  296.  
  297.     { Make sure it is a file}
  298.         if BitTest(@paramBlock.ioFlAttrib, 8, 4) then
  299.             begin
  300.                 reportToUser(paramPtr, 'Sorry, directories do not have creators.');
  301.                 exit(FileCreator);
  302.             end;
  303.  
  304.     { Now set the return value.  Use FileName as a temp variable}
  305.         FileName := '1234';
  306.         for charIndex := 1 to 4 do
  307.             FileName[charIndex] := paramBlock.ioFlFndrInfo.fdCreator[charIndex];
  308.  
  309.         paramPtr^.returnValue := PasToZero(paramPtr, FileName);
  310.     end;
  311.  
  312. end.